Deutsche Edition 1/Deutsche Edition 1.iso/amok/amok_lha/amok46.lha/M2SDS/CONTOOLS.IMP

Text File | 1993-08-15 | 32KB | 1,041 lines

IMPLEMENTATION MODULE ConTools;
  FROM SYSTEM IMPORT SWI, RegAX, RegCX, STRING;
  FROM ASCII IMPORT space, esc, bs, bel;
  IMPORT Terminal;
  FROM String IMPORT StrToArray, ArrayToStr;
  IMPORT String;
  FROM Geometry IMPORT Point, Rectangle;
  FROM Screen IMPORT Fore, Back, SetCursor, Scroll, Colors;
  IMPORT Screen;
  CONST
    sp = space;
    ControlC = 3C;
    cr = 36C;
  VAR
    Cursor : Point;
    aBereich : TBereich;
  (*---------------------------------------------------------------------
    * Proceduren zur Behandlung von Strings als ARRAY OF CHAR,
    * hier implementiert da nicht zur Verfgung gestellt.
    ---------------------------------------------------------------------
    *)
  PROCEDURE Length(Satz : ARRAY OF CHAR): CARDINAL;
    VAR
      i : CARDINAL;
    BEGIN
      i := 0;
      WHILE (i<HIGH(Satz)) AND (Satz[i]#0C) DO
        INC(i);
      END;
      RETURN i;
    END Length;
  PROCEDURE Copy(VAR S1 : ARRAY OF CHAR; S2 : ARRAY OF CHAR);
    VAR
      i : CARDINAL;
    BEGIN
      i := 0;
      WHILE (i<HIGH(S1)) AND (i<HIGH(S2)) AND (S2[i]#0C) DO
        S1[i] := S2[i];
        INC(i);
      END;
      S1[i] := 0C;
    END Copy;
  PROCEDURE Delete(VAR S : ARRAY OF CHAR; Pos, Count : CARDINAL);
    VAR
      str : STRING[255];
    BEGIN
      ArrayToStr(S, str);
      String.Delete(str, Pos+1, Count);
      StrToArray(str, S);
    END Delete;
  (*--------------------------------------------------------------------
    * Ausgaberoutinen, aufbauend auf Write.
    --------------------------------------------------------------------
    *)
  PROCEDURE Write(Zeichen : CHAR);
    (*
      * Write:
      *  Ausgabe eines einzelnen Zeichens, falls ausgebbar.
      *  Der aktuelle Bereich wird beachtet.
    *)
    BEGIN
      IF Zeichen>=sp THEN
        IF Cursor.x<aBereich.B.left THEN
          Cursor.x := aBereich.B.left;
        ELSIF Cursor.x>aBereich.B.right THEN
          Cursor.x := aBereich.B.right;
        END;
        IF Cursor.y<aBereich.B.top THEN
          Cursor.y := aBereich.B.top;
        ELSIF Cursor.y>aBereich.B.bottom THEN
          Cursor.y := aBereich.B.bottom;
        END;
        IF Cursor.x<aBereich.B.right THEN
          SetCursor(Cursor);
          Screen.Write(Zeichen);
          INC(Cursor.x);
        ELSIF Cursor.y<aBereich.B.bottom-1 THEN
          Cursor.x := aBereich.B.left;
          INC(Cursor.y);
          SetCursor(Cursor);
          Screen.Write(Zeichen);
        ELSE
          Cursor.x := aBereich.B.left;
          Cursor.y := aBereich.B.bottom-1;
          Scroll(aBereich.B, 1);
          SetCursor(Cursor);
          Screen.Write(Zeichen);
        END;
      END;
    END Write;
  PROCEDURE WriteLn();
    (*
      * WriteLn:
      *  Ausgabe in neue Zeile, bei der letzten Zeile des Bereiches wird
      *  dieser gescrollt.
    *)
    BEGIN
      Cursor.x := aBereich.B.left;
      IF Cursor.y<aBereich.B.bottom-1 THEN
        INC(Cursor.y);
        SetCursor(Cursor);
      ELSE
        Cursor.y := aBereich.B.bottom-1;
        Scroll(aBereich.B, 1);
        SetCursor(Cursor);
      END;
    END WriteLn;
  PROCEDURE WriteString(Satz : ARRAY OF CHAR);
    (*
      * WriteString:
      *  Ausgabe des Satzes mittels Write. Das Satzende muá mit dem
      *  Nullzeichen terminiert sein, falls weniger als HIGH (Satz) Zeichen
      *  auszugeben sind.
    *)
    VAR
      i : CARDINAL;
    BEGIN
      i := 0;
      WHILE (i<=HIGH(Satz)) AND (Satz[i]#0C) DO
        Write(Satz[i]);
        INC(i);
      END;
    END WriteString;
  PROCEDURE CardToArray(VAR Satz : ARRAY OF CHAR; Zahl : CARDINAL;
      n : INTEGER);
    (*
      * CardToArray:
      *  Hilfsprocedur, insbesondere fr WriteCard.
      *  Die Zahl wird in den Satz bertragen, formatiert auf n Zeichen,
      *  Fr positive n erfolgt die Formatierung rechtsbndig, fr negative
      *  linksbndig.
    *)
    VAR
      i, z, h : CARDINAL;
      S : ARRAY [0..20] OF CHAR;
    BEGIN
      (*                                                  L„nge gltig? *)
      IF (n>0) AND (n>INTEGER(HIGH(Satz))) THEN
        n := INTEGER(HIGH(Satz));
      ELSIF (n<0) AND (-n>INTEGER(HIGH(Satz))) THEN
        n := -INTEGER(HIGH(Satz));
      END;
      IF n>20 THEN
        n := 20;
      ELSIF n<-20 THEN
        n := -20;
      END;
      i := 0;
      (*                                          n”tige Ziffern z„hlen *)
      IF Zahl=0 THEN
        (*                                              Sonderfall Null *)
        z := 1;
      ELSE
        (*              Ziffern in umgekehrter Reihenfolge in S sichern *)
        h := Zahl;
        z := 0;
        WHILE h>0 DO
          S[z] := CHR((h MOD 10)+ORD("0"));
          h := h DIV 10;
          INC(z);
        END;
      END;
      (*                                            rechtsbndig fllen *)
      WHILE INTEGER(i+z) < n DO
        Satz[i] := " ";
        INC(i);
      END;
      IF Zahl=0 THEN
        (*                                              Sonderfall Null *)
        Satz[i] := "0";
        INC(i);
      ELSE
        (*                         in S gespeicherte Ziffern umkopieren *)
        WHILE z>0 DO
          DEC(z);
          Satz[i] := S[z];
          INC(i);
        END;
      END;
      (*                                              linksbnig fllen *)
      WHILE INTEGER(i) < n DO
        Satz[i] := " ";
        INC(i);
      END;
      (*                                    Terminationszeichen anfgen *)
      IF i<HIGH(Satz) THEN
        Satz[i] := 0C;
      END;
    END CardToArray;
  PROCEDURE WriteCard(Zahl : CARDINAL; n : INTEGER);
    (*
      * WriteCard:
      *  Die Zahl wird mit CardToArray in den Satz konvertiert und
      *  ausgeben.
    *)
    VAR
      i : INTEGER;
      satz : ARRAY [0..10] OF CHAR;
    BEGIN
      CardToArray(satz, Zahl, n);
      WriteString(satz);
    END WriteCard;
  PROCEDURE IntToArray(VAR Satz : ARRAY OF CHAR; Zahl : LONGINT; n :
      INTEGER);
    (*
      * IntToArray:
      *  Hilfsprocedure, siehe auch CardToArray.
      *  Die Zahl wir formatiert in den Satz gespeichert.
     *)
    VAR
      i, z, Negativ : CARDINAL;
      h : LONGINT;
      S : ARRAY [0..20] OF CHAR;
    BEGIN
      IF (n>0) AND (n>INTEGER(HIGH(Satz))) THEN
        n := INTEGER(HIGH(Satz));
      ELSIF (n<0) AND (-n>INTEGER(HIGH(Satz))) THEN
        n := -INTEGER(HIGH(Satz));
      END;
      IF n>20 THEN
        n := 20;
      ELSIF n<-20 THEN
        n := -20;
      END;
      (*                                        Negativ ist Sonderfall *)
      IF Zahl<LONGINT(0) THEN
        Zahl := -Zahl;
        Negativ := 1;
      ELSE
        Negativ := 0;
      END;
      IF Zahl=LONGINT(0) THEN
        z := 1;
      ELSE
        h := Zahl;
        z := 0;
        WHILE h>LONGINT(0) DO
          S[z] := CHR(CARDINAL(h MOD LONGINT(10))+ORD("0"));
          h := h DIV LONGINT(10);
          INC(z);
        END;
      END;
      i := 0;
      WHILE INTEGER(i+z+Negativ) < n DO
        Satz[i] := " ";
        INC(i);
      END;
      IF Zahl=LONGINT(0) THEN
        Satz[i] := "0";
        INC(i);
      ELSE
        (*                       Falls Negativ Minuszeichen vorsetzten *)
        IF Negativ=1 THEN
          Satz[i] := "-";
          INC(i);
        END;
        WHILE z>0 DO
          DEC(z);
          Satz[i] := S[z];
          INC(i);
        END;
      END;
      WHILE n < -INTEGER (i) DO
        Satz[i] := " ";
        INC(i);
      END;
      IF i<HIGH(Satz) THEN
        Satz[i] := 0C;
      ELSE
        Satz[HIGH(Satz)] := 0C;
      END;
    END IntToArray;
  PROCEDURE ArrayToInt(VAR Zahl : LONGINT; Satz : ARRAY OF CHAR;
    VAR Fehler : BOOLEAN);
    (*
      * ArrayToInt:
      *  Konvertierung eines Satzes in eine Zahl,
      *  der Satz darf als erstes Zeichen nur ein Minuszeichen oder
      *  Ziffern enthalten, weiter sind nur Ziffern erlaubt.
      *  Der Parameter Fehler gibt den Erfolg der Umwandlung wieder.
    *)
    VAR
      i : CARDINAL;
      Negativ : BOOLEAN;
    BEGIN
      (*                                               Initialisierung *)
      Fehler := FALSE;
      Zahl := LONGINT(0);
      i := 0;
      (*                                      Minuszeichen herausl”sen *)
      Negativ := (Satz[i]="-");
      IF Negativ THEN
        INC(i);
      END;
      (*                                     Ziffernweise konvertieren *)
      WHILE (i<HIGH(Satz)) AND (Satz[i]#0C) DO
        IF ("0"<=Satz[i]) AND (Satz[i]<="9") THEN
          Zahl := Zahl*LONGINT(10)+LONGINT(ORD(Satz[i])-ORD("0"));
          INC(i);
        ELSE
          Fehler := TRUE;
          RETURN;
        END;
      END;
      (*                                       Sonderfall Zahl Negativ *)
      IF Negativ THEN
        Zahl := -Zahl;
      END;
    END ArrayToInt;
  PROCEDURE WriteInt(Zahl : LONGINT; n : INTEGER);
    (*
      * WriteInt:
      *  Ausgabe einer Zahl, siehe auch WriteCard.
    *)
    VAR
      i : INTEGER;
      satz : ARRAY [0..20] OF CHAR;
    BEGIN
      IntToArray(satz, Zahl, n);
      WriteString(satz);
    END WriteInt;
  (*
    ---------------------------------------------------------------------
    *)
  PROCEDURE ZeichenIstErlaubt(Zeichen : CHAR; erlaubteZeichen :
      TZeichenMenge; VAR Status : TStatus): BOOLEAN;
    (*
      * ZeichenIstErlaubt:
      *  interne Hilfsfunktion,
      *  stellt fest, welches Zeichen welchen Status ergibt.
      *  Resultat: "Zeichen IN erlaubteZeichen"
    *)
    BEGIN
      IF SonderEingabe THEN
        CASE Zeichen OF
        | func1..func10 :
          Status := VAL(TStatus,(ORD(Zeichen)-ORD(func1)+ORD(
              Funktion1)));
        | sfunc1..sfunc10 :
          Status := VAL(TStatus,(ORD(Zeichen)-ORD(sfunc1)+ORD(
              sFunktion1)));
        | help :
          Status := Hilfe;
        | up :
          Status := Oben;
        | down :
          Status := Unten;
        | sup :
          Status := SeiteOben;
        | sdown :
          Status := SeiteUnten;
        | btab :
          Status := Links;
        | ins :
          Status := Funktion9;
        | pos1 :
          Status := sFunktion10;
        | end :
          Status := Funktion10;
        | sleft, sright, del, left, right :
          RETURN TRUE;
        ELSE
          RETURN FALSE;
        END;
      ELSE
        CASE Zeichen OF
        | esc :
          Status := Zurueck;
        | tab :
          Status := Rechts;
        | cr :
          Status := Ende;
        | bs, sp :
          RETURN TRUE;
        ELSE
          IF (CAP(Zeichen)="J") OR (CAP(Zeichen)="N") THEN
            RETURN (JaNein IN erlaubteZeichen) OR (Buchstaben IN
                erlaubteZeichen) OR (alleZeichen IN erlaubteZeichen);
          ELSIF (("A"<=Zeichen) AND (Zeichen<="Z") OR ("a"
              <=Zeichen) AND (Zeichen<="z")) THEN
            RETURN (Buchstaben IN erlaubteZeichen) OR (alleZeichen IN
                erlaubteZeichen);
          ELSIF ("0"<=Zeichen) AND (Zeichen<="9") THEN
            RETURN (Ziffern IN erlaubteZeichen) OR (eZiffern IN
                erlaubteZeichen) OR (alleZeichen IN erlaubteZeichen);
          ELSIF (Zeichen="+") OR (Zeichen="-") OR (Zeichen=".") THEN
            RETURN (eZiffern IN erlaubteZeichen) OR (alleZeichen IN
                erlaubteZeichen);
          ELSE
            RETURN alleZeichen IN erlaubteZeichen;
          END;
        END;
      END;
      IF ((Status>=Funktion1) AND (Funktion IN erlaubteZeichen))
          OR ((Status<Funktion1) AND (VAL(TZeichen,ORD(Status)-ORD(
          Ende)) IN erlaubteZeichen)) THEN
        RETURN TRUE;
      ELSE
        Status := Normal;
        RETURN FALSE;
      END;
    END ZeichenIstErlaubt;
  (*
    ---------------------------------------------------------------------
    *)
  PROCEDURE TasteGedrueckt(): BOOLEAN;
    (*
      * TasteGedrueckt:
      *  Resultat: BOOLEAN, ob noch Zeichen im Tastaturbuffer sind,
      *  intern realisiert ber Terminal, BIOS Funktion.
    *)
    BEGIN
      RETURN Terminal.BusyRead();
    END TasteGedrueckt;
  PROCEDURE Read(VAR Zeichen : CHAR);
    (*
      * Read:
      *  Einlesen eines Zeichens ohne Echo, bei einer Sondereingabe wird
      *  die Variable gesetzt.
      *  intern ber Terminal, BIOS Funktion.
    *)
    BEGIN
      Terminal.Read(Zeichen);
      SonderEingabe := (Zeichen=0C);
      IF SonderEingabe THEN
        Terminal.Read(Zeichen);
      END;
    END Read;
  PROCEDURE ReadString(X, Y, Laenge : CARDINAL; erlaubteZeichen :
      TZeichenMenge; VAR Satz : ARRAY OF CHAR);
    (*
      * ReadString:
      *  Eingabe eines Satzes, siehe auch Definitionsmodul.
    *)
    VAR
      i, Pos : CARDINAL;
      Zeichen : CHAR;
    BEGIN
      (*                    Return erlaubt, sonst nicht terminierend. *)
      INCL(erlaubteZeichen, Return);
      Pos := 0;
      (*          Satz auf Laenge bringen, ggf mit Leerzeichen fllen *)
      i := 0;
      WHILE (Satz[i]#0C) AND (i<HIGH(Satz)) DO
        INC(i);
      END;
      IF i>Laenge THEN
        Satz[Laenge] := 0C;
      ELSE
        WHILE i<Laenge DO
          Satz[i] := sp;
          INC(i);
        END;
        Satz[Laenge] := 0C;
      END;
      (*                                           Ausgabe des Satzes *)
      InverseAusgabe();
      SetzePosition(X, Y);
      WriteString(Satz);
      Status := Normal;
      REPEAT
        (*                                Cursor auf Position bringen *)
        SetzePosition(X+Pos, Y);
        CursorAn();
        (*                                 erlaubtes Zeichen einlesen *)
        REPEAT
          Read(Zeichen);
        UNTIL ZeichenIstErlaubt(Zeichen,erlaubteZeichen+TZeichenMenge{
            Funktion},Status);
        CursorAus();
        IF SonderEingabe THEN
          CASE Zeichen OF
          | left :
                                                (* Zeichen links *)
            IF Pos>0 THEN
              DEC(Pos);
            END;
          | right :
                                                (* Zeichen rechts *)
            IF Pos<Laenge-1 THEN
              INC(Pos);
            END;
          | del :
                                                (* Zeichen rechts l”schen *)
            i := Pos+1;
            WHILE (i<Laenge-1) DO
              Satz[i-1] := Satz[i];
              INC(i);
            END;
            Satz[Laenge-1] := sp;
            SetzePosition(X, Y);
            WriteString(Satz);
          | end, func10 :
                                                (* Ende *)
            Status := Normal;
            Pos := Laenge-1;
            WHILE (Pos>0) AND (Satz[Pos]=sp) DO
              DEC(Pos);
            END;
            IF Pos<Laenge-1 THEN
              INC(Pos);
            END;
          | pos1, sfunc10 :
                                                (* Anfang *)
            Status := Normal;
            Pos := 0;
          | ins, func9 :
                                                (* Leerzeichen einfgen *)
            Status := Normal;
            FOR i := Laenge-1 TO Pos+1 BY -1 DO
              Satz[i] := Satz[i-1];
            END;
            Satz[Pos] := sp;
            SetzePosition(X, Y);
            WriteString(Satz);
          | sfunc9 :
                                                (* Alles l”schen *)
            Status := Normal;
            Pos := Laenge;
            Satz[Laenge] := 0C;
            WHILE Pos>0 DO
              DEC(Pos);
              Satz[Pos] := sp;
            END;
            SetzePosition(X, Y);
            WriteString(Satz);
          | func8 :
                                                (* L”sche bis Ende *)
            Status := Normal;
            i := Pos;
            WHILE i<Laenge DO
              Satz[i] := sp;
              INC(i);
            END;
            SetzePosition(X, Y);
            WriteString(Satz);
          | sfunc8 :
                                                (* L”sche bis Anfang *)
            Status := Normal;
            IF Pos>0 THEN
              Delete(Satz, 0, Pos);
              i := Length(Satz);
              WHILE i<Laenge DO
                Satz[i] := sp;
                INC(i);
              END;
              Satz[Laenge] := 0C;
              SetzePosition(X, Y);
              WriteString(Satz);
              Pos := 0;
            END;
          | sleft :
                                                (* Wort links *)
            WHILE (Pos>0) AND ((Satz[Pos]<"A") OR (("Z"
                <Satz[Pos]) AND (Satz[Pos]<"a")) OR (("z"
                <Satz[Pos]) AND (Satz[Pos]<200C)) OR (245C<Satz[Pos])) DO
              DEC(Pos);
            END;
            WHILE (Pos>0) AND ((("A"<=Satz[Pos]) AND (Satz[Pos]<="Z"
                )) OR (("a"<=Satz[Pos]) AND (Satz[Pos]<="z"
                )) OR ((200C<=Satz[Pos]) AND (Satz[Pos]<=245C))) DO
              DEC(Pos);
            END;
          | sright :
                                                (* Wort rechts *)
            WHILE (Pos<Laenge-1) AND ((Satz[Pos]<"A") OR (("Z"
                <Satz[Pos]) AND (Satz[Pos]<"a")) OR (("z"
                <Satz[Pos]) AND (Satz[Pos]<200C)) OR (245C<Satz[Pos])) DO
              INC(Pos);
            END;
            WHILE (Pos<Laenge-1) AND ((("A"
                <=Satz[Pos]) AND (Satz[Pos]<="Z")) OR (("a"
                <=Satz[Pos]) AND (Satz[Pos]<="z"
                )) OR ((200C<=Satz[Pos]) AND (Satz[Pos]<=245C))) DO
              INC(Pos);
            END;
          ELSE
            IF (NOT (Funktion IN erlaubteZeichen)) AND (Status>=
                Funktion1) THEN
              Status := Normal;
            END;
          END;
        ELSE
       (* NOT SonderEingabe *)
          CASE Zeichen OF
          | cr, esc :
                                                (* Leer; Status schon gesetzt *)
          | bs :
                                                (* Zeichen links l”schen *)
            IF Pos>0 THEN
              DEC(Pos);
              i := Pos;
              WHILE (i<Laenge-1) DO
                Satz[i] := Satz[i+1];
                INC(i);
              END;
              Satz[Laenge-1] := sp;
              SetzePosition(X, Y);
              WriteString(Satz);
            END;
          ELSE
                                                (* Normale Eingabe *)
            Satz[Pos] := Zeichen;
            SetzePosition(X+Pos, Y);
            Write(Zeichen);
            IF Pos<Laenge-1 THEN
              INC(Pos);
            END;
          END;
        END;
        (*                       Ende der Eingabe falls Status gesetzt *)
      UNTIL Status#Normal;
      (*                       Satz wieder in normaler Farbe ausgeben. *)
      NormaleAusgabe();
      SetzePosition(X, Y);
      WriteString(Satz);
      (*                           abschlieáende Leerzeichen entfernen *)
      i := Laenge;
      WHILE (i>0) AND (Satz[i-1]=sp) DO
        DEC(i);
        Satz[i] := 0C;
      END;
    END ReadString;
  PROCEDURE ReadLongInt(X, Y, Laenge : CARDINAL; erlaubteZeichen :
      TZeichenMenge; VAR Zahl : LONGINT);
    (*
      * ReadLongInt:
      *  Eingabe einer korrekten Zahl mit ReadString.
    *)
    VAR
      Fehler : BOOLEAN;
      i : CARDINAL;
      Satz : ARRAY [0..15] OF CHAR;
    BEGIN
      erlaubteZeichen := erlaubteZeichen-TZeichenMenge{alleZeichen,
          Buchstaben,JaNein}+TZeichenMenge{eZiffern};
      IF Laenge>15 THEN
        Laenge := 15;
      END;
      IntToArray(Satz, Zahl, -INTEGER(Laenge));
      REPEAT
        ReadString(X, Y, Laenge, erlaubteZeichen, Satz);
        ArrayToInt(Zahl, Satz, Fehler);
        IF Fehler THEN
          Write(bel);
        END;
      UNTIL NOT Fehler;
      SetzePosition(X, Y);
      WriteInt(Zahl, INTEGER(Laenge));
    END ReadLongInt;
  (*
    --------------------------------------------------------------------
    *)
  PROCEDURE LoescheAusgabe();
    (*
      * LoescheAusgabe:
      *  aktiven Bereich l”schen,
      *  intern ber Screen.Scroll um Null Zeilen, BIOS Funktionsgruppe 16.
    *)
    BEGIN
      Scroll(aBereich.B, 0);
    END LoescheAusgabe;
  PROCEDURE SetzePosition(X, Y : CARDINAL);
    (*
      * SetzePosition:
      *  Cusorposition einstellen, Kontrolle erfolgt bei Write, WriteLn.
    *)
    BEGIN
      Cursor.x := aBereich.B.left+INTEGER(X)-1;
      Cursor.y := aBereich.B.top+INTEGER(Y)-1;
      SetCursor(Cursor);
    END SetzePosition;
  PROCEDURE SetzeFarben(VFarbe, HFarbe : CARDINAL);
    (*
      * SetzeFarben:
      *  Farben setzen ber Variable des Modules Screen,
      *  intern BIOS Funktsionsgruppe 16.
      *  BEACHTE Farbeeffekte fr Hintergrundfarben.
    *)
    BEGIN
      Fore := VAL(Colors,VFarbe);
      Back := VAL(Colors,HFarbe);
    END SetzeFarben;
  PROCEDURE NormaleAusgabe();
    (*
      * NormaleAusgabe:
      *  Farben auf (Vordergrund, Hintergrund) einstellen.
    *)
    BEGIN
      Fore := aBereich.VFarbe;
      Back := aBereich.HFarbe;
    END NormaleAusgabe;
  PROCEDURE InverseAusgabe();
    (*
      * InverseAusgabe:
      *  Farben auf (Hintergrund, Vordergrund) einstellen.
    *)
    BEGIN
      Fore := aBereich.HFarbe;
      Back := aBereich.VFarbe;
    END InverseAusgabe;
  PROCEDURE CursorAn();
    (*
      * CursorAn:
      *  Cursor ber BIOS Funktion (10, 100) einstellen,
      *  ersteCursorZeile = 1, letzteCursorZeile = 7
    *)
    BEGIN
      RegAX := 100H;
      RegCX := 263;
      SWI(10H);
    END CursorAn;
  PROCEDURE CursorAus();
    (*
      * CursorAus:
      *  Cursor ber BIOS Funktion (10, 100) einstellen,
      *  da Start- und Endzeile zum vollst„ndigen verschwinden des Cursors
      *  nicht gefunden wurden wird ersteCursorZeile = 6,
      *  letzteCursorZeile = 7 definiert.
      *  BEACHTE diese Werte sind spezifisch fr jeden PC-Kompatiblen,
      *  gewisse Werte fhren zu interessanten Effekten in der
      *  Videodarstellung!
    *)
    BEGIN
      RegAX := 100H;
      RegCX := 1543;
      SWI(10H);
    END CursorAus;
  PROCEDURE ZeileEinfuegen();
    (*
      * ZeileEinfuegen:
      *  an der aktuellen Cursorposition wird eine Zeile eingefgt.
      *  Mit Hilfe der Procedure Scroll wird ein Rechteck eum eine Zeile
      *  nach unten gescrollt.
    *)
    VAR
      Hilfe : Rectangle;
    BEGIN
      Hilfe := aBereich.B;
      Hilfe.top := Cursor.y;
      Scroll(Hilfe, -1);
    END ZeileEinfuegen;
  PROCEDURE ZeileLoeschen();
    (*
      * ZeileL”schen:
      *  die Zeile, in der der Cursor ist wird gel”scht.
      *  Mit Hilfe der Procedure Scroll wird ein  Rechteck um eine Zeile
      *  nach oben gescrollt.
    *)
    VAR
      Hilfe : Rectangle;
    BEGIN
      Hilfe := aBereich.B;
      Hilfe.top := Cursor.y;
      Scroll(Hilfe, 1);
    END ZeileLoeschen;
  PROCEDURE ScrollHoch(n : CARDINAL);
    (*
      * ScrollHoch:
      *  der aktuelle Bereich wird um n zeilen nach oben gescrollt,
      *  n = 0 wird verhindert, da sonst der Bereich gel”scht wird.
    *)
    BEGIN
      IF n#0 THEN
        Scroll(aBereich.B, INTEGER(n));
      END;
    END ScrollHoch;
  PROCEDURE ScrollRunter(n : CARDINAL);
    (*
      * ScrollRunter:
      *  siehe auch ScrollHoch
    *)
    BEGIN
      IF n#0 THEN
        Scroll(aBereich.B, -INTEGER(n));
      END;
    END ScrollRunter;
  (*
    ----------------------------------------------------------------------
    *)
  PROCEDURE DefiniereBereich(VAR Bereich : TBereich; Links, Oben,
      Breite, Hoehe, VFarbe, HFarbe : CARDINAL);
    (*
      * DefiniereBereich:
      *  dient zur Initialisierung des Bereiches
    *)
    BEGIN
      WITH Bereich DO
        B.left := INTEGER(Links)-1;
        B.top := INTEGER(Oben)-1;
        B.right := B.left+INTEGER(Breite);
        B.bottom := B.top+INTEGER(Hoehe);
      END;
      Bereich.VFarbe := VAL(Colors,VFarbe);
      Bereich.HFarbe := VAL(Colors,HFarbe);
    END DefiniereBereich;
  PROCEDURE BenutzeBereich(Bereich : TBereich);
    (*
      * BenutzeBereich:
      *  nimmt einen vorher initialisierten Bereich als neuen aktuellen.
    *)
    BEGIN
      aBereich := Bereich;
      Fore := aBereich.VFarbe;
      Back := aBereich.HFarbe;
      SetzePosition(1, 1);
    END BenutzeBereich;
  PROCEDURE DefiniereZeile(VAR Zeile : TZeile; Wahl, Anzahl : CARDINAL;
      erlaubteZeichen : TZeichenMenge; P1, P2, P3, P4, P5, P6, P7,
      P8, P9, P10 : ARRAY OF CHAR);
    (*
      * DefiniereZeile:
      *  Initialisiert die Datenstruktur, zu benutzen bei einer
      *  ZeilenWahl
    *)
    BEGIN
      Zeile.Wahl := Wahl;
      Zeile.Anzahl := Anzahl;
      Zeile.erlaubteZeichen := erlaubteZeichen;
      WITH Zeile DO
        Copy(Punkt[1], P1);
        Copy(Punkt[2], P2);
        Copy(Punkt[3], P3);
        Copy(Punkt[4], P4);
        Copy(Punkt[5], P5);
        Copy(Punkt[6], P6);
        Copy(Punkt[7], P7);
        Copy(Punkt[8], P8);
        Copy(Punkt[9], P9);
        Copy(Punkt[10], P10);
      END;
    END DefiniereZeile;
  PROCEDURE DefiniereMenue(VAR Menue : TMenue; Wahl, Anzahl, XTitel,
      YTitel, XPunkt, YPunkt : CARDINAL; Bereich : TBereich; Titel,
      P1, P2, P3, P4, P5, P6, P7, P8, P9, P10 : ARRAY OF CHAR);
    (*
      * DefiniereMenue:
      *  Initialisiert eine Datenstruktur, zu benutzen bei einer
      *  MenueWahl.
    *)
    BEGIN
      Menue.Wahl := Wahl;
      Menue.Anzahl := Anzahl;
      Menue.XTitel := XTitel;
      Menue.YTitel := YTitel;
      Menue.XPunkt := XPunkt;
      Menue.YPunkt := YPunkt;
      Menue.Bereich := Bereich;
      Copy(Menue.Titel, Titel);
      WITH Menue DO
        Copy(Punkt[1], P1);
        Copy(Punkt[2], P2);
        Copy(Punkt[3], P3);
        Copy(Punkt[4], P4);
        Copy(Punkt[5], P5);
        Copy(Punkt[6], P6);
        Copy(Punkt[7], P7);
        Copy(Punkt[8], P8);
        Copy(Punkt[9], P9);
        Copy(Punkt[10], P10);
      END;
    END DefiniereMenue;
  (*
    ----------------------------------------------------------------------
    *)
  PROCEDURE Meldung(Satz : ARRAY OF CHAR; Warte : BOOLEAN);
    (*
      * Meldung:
      *  siehe auch Definitionsmodul.
    *)
    VAR
      Zeichen : CHAR;
    BEGIN
      BenutzeBereich(Kommentar);
      LoescheAusgabe();
      SetzePosition(2, 2);
      WriteString(Satz);
      IF Warte THEN
        CursorAn();
        IF TasteGedrueckt() THEN
          Read(Zeichen);
        END;
        Read(Zeichen);
        CursorAus();
      END;
    END Meldung;
  PROCEDURE MenueWahl(VAR Menue : TMenue; neuesMenue : BOOLEAN);
    (*
      * MenueWahl:
      *  siehe auch Definitionsmodul.
    *)
    VAR
      Zeichen : CHAR;
      i : CARDINAL;
    BEGIN
      WITH Menue DO
        BenutzeBereich(Kommentar);
        LoescheAusgabe();
        WriteString("W„hlen Sie mit den Pfeiltasten einen Punkt und");
        WriteLn();
        WriteString("aktivieren Sie den ausgew„hlten Punkt mit <RETURN>");
        BenutzeBereich(Bereich);
        IF neuesMenue THEN
          LoescheAusgabe();
          SetzePosition(XTitel, YTitel);
          WriteString(Titel);
          NormaleAusgabe();
          FOR i := 1 TO Anzahl DO
            SetzePosition(XPunkt, YPunkt-1+i);
            WriteString(Punkt[i]);
          END;
        END;
        REPEAT
          InverseAusgabe();
          SetzePosition(XPunkt, YPunkt-1+Wahl);
          WriteString(Punkt[Wahl]);
          NormaleAusgabe();
          REPEAT
            Read(Zeichen);
          UNTIL ZeichenIstErlaubt(Zeichen,TZeichenMenge{Escape,Return,
              Hoch,Runter},Status);
          IF Status#Ende THEN
            SetzePosition(XPunkt, YPunkt-1+Wahl);
            WriteString(Punkt[Wahl]);
          END;
          IF SonderEingabe THEN
            CASE Zeichen OF
            | up, left :
              IF Wahl=1 THEN
                Wahl := Anzahl;
              ELSE
                DEC(Wahl);
              END;
            | down, right :
              IF Wahl=Anzahl THEN
                Wahl := 1;
              ELSE
                INC(Wahl);
              END;
            ELSE
            END;
          ELSE
            CASE Zeichen OF
            | esc :
              Wahl := Anzahl;
            ELSE
            END;
          END;
        UNTIL NOT (SonderEingabe) AND (Zeichen=cr);
        BenutzeBereich(Kommentar);
        LoescheAusgabe();
        BenutzeBereich(Bereich);
      END;
    END MenueWahl;
  PROCEDURE ZeilenWahl(X, Y : CARDINAL; VAR Zeile : TZeile);
    (*
      * ZeilenWahl:
      *  siehe auch Definitionsmodul.
    *)
    VAR
      Zeichen : CHAR;
    BEGIN
      WITH Zeile DO
        erlaubteZeichen := erlaubteZeichen+TZeichenMenge{Return};
        Status := Normal;
        REPEAT
          InverseAusgabe();
          SetzePosition(X, Y);
          WriteString(Punkt[Wahl]);
          SetzePosition(X, Y);
          CursorAn();
          REPEAT
            Read(Zeichen);
          UNTIL ZeichenIstErlaubt(Zeichen,erlaubteZeichen,Status);
          CursorAus();
          IF SonderEingabe THEN
            CASE Zeichen OF
            | left :
              IF Wahl>1 THEN
                DEC(Wahl);
              ELSE
                Wahl := Anzahl;
              END;
            | right :
              IF Wahl<Anzahl THEN
                INC(Wahl);
              ELSE
                Wahl := 1;
              END;
            ELSE
            END;
          ELSE
            CASE Zeichen OF
            | sp :
              IF Wahl<Anzahl THEN
                INC(Wahl);
              ELSE
                Wahl := 1;
              END;
            ELSE
            END;
          END;
        UNTIL Status#Normal;
        NormaleAusgabe();
        SetzePosition(X, Y);
        WriteString(Punkt[Wahl]);
      END;
    END ZeilenWahl;
  PROCEDURE ZeichenWahl(X, Y : CARDINAL; Satz : ARRAY OF CHAR;
      erlaubteZeichen : TZeichenMenge; VAR Zeichen : CHAR);
    BEGIN
      SetzePosition(X, Y);
      WriteString(Satz);
      Write(" ");
      CursorAn();
      REPEAT
        Read(Zeichen);
      UNTIL ZeichenIstErlaubt(Zeichen,erlaubteZeichen,Status);
      IF NOT SonderEingabe AND (sp<=Zeichen) THEN
        Write(Zeichen);
      END;
      CursorAus();
    END ZeichenWahl;
  (*
    MODULE ConTools ---------------------------------------------------
    *)
  BEGIN
    (*
      * Initialisierung des Moduls:
      *  CursorAusschalten, Kommentarbereich definieren, aktuellen
      *  Bereich initialisieren, Bildschirm l”schen, Position (1,1) setzen.
    *)
    CursorAus();
    DefiniereBereich(Kommentar, 2, 21, 75, 3, 0, 1);
    DefiniereBereich(aBereich, 1, 1, 80, 24, 0, 3);
    BenutzeBereich(aBereich);
    SetzePosition(1, 1);
    LoescheAusgabe();
  END ConTools.